今回は、スライド形式だと扱いにくい内容もありますので、bookdownでの作成となっています。 わかりにくい点など、多々あると思いますがよろしくお願いします。
今回、乱数生成するところがありますが、set.seed()を設定していないので実行結果は異なります。
brew tap homebrew/science
brew install r
sudo apt-get install r-base
sudo yum install epel-release
sudo yum --enablerepo=epel install R
brew cask install rstudio
wget https://download1.rstudio.org/rstudio-1.1.447-amd64.deb
sudo dpkg -i rstudio-1.1.447-amd64.deb
sudo yum install wget
wget https://download1.rstudio.org/rstudio-1.1.456-x86_64.rpm
sudo yum install rstudio-server-rhel-1.1.442-x86_64.rpm
| 演算子 | 使い方 | 結果 |
|---|---|---|
+ |
1 + 2 |
3 |
- |
1 - 2 |
-1 |
* |
2 * 3 |
6 |
/ |
2 / 3 |
0.6666667 |
^ |
2 ^ 3 |
8 |
%/% |
13 %/% 5 |
2 |
%% |
13 %% 5 |
3 |
'+'(1, 2)
#> [1] 3
= は非推奨,<- を使う->も使えるけど、あまりつかわない<<- はグローバル環境への代入
<<-よりもassign関数を使うほうがいい| 演算子 | 使い方 |
|---|---|
<- |
a <- 3 |
-> |
3 -> a |
<<- |
a <<- 5 |
""でくくる。TRUEとFALSEhoge <- "やっほー"
fuga <- 1.414
foo <- TRUE
hoge; fuga; foo
#> [1] "やっほー"
#> [1] 1.414
#> [1] TRUE
c()を使う
hoge <- c("やっほー", "おっはー")
fuga <- c(1.414, 1.732)
foo <- c(TRUE,FALSE)
hoge; fuga; foo
#> [1] "やっほー" "おっはー"
#> [1] 1.414 1.732
#> [1] TRUE FALSE
hoge2 <- c("やっほー", 1, TRUE)
fuga2 <- c(1.414, TRUE)
hoge2; fuga2
#> [1] "やっほー" "1" "TRUE"
#> [1] 1.414 1.000
quiz1 <- c(1+TRUE, "やっほー")
quiz2 <- c(1+TRUE, 3) * FALSE
quiz1
#> [1] "2" "やっほー"
quiz2
#> [1] 0 0
TRUEは1に,FALSEは0になります。
a <- c(1,2,3,4)
b <- c(1,2)
c <- c(1,2,3)
a * 3
#> [1] 3 6 9 12
a + b
#> [1] 2 4 4 6
b + a
#> [1] 2 4 4 6
a * c
#> Warning in a * c: longer object length is not a multiple of shorter object
#> length
#> [1] 1 4 9 4
[1]からはじまる!
[行番号,列番号]で参照する!a <- c(1,2,3,4)
dim(a) <- c(2,2) #2次元配列
a
#> [,1] [,2]
#> [1,] 1 3
#> [2,] 2 4
a[1,2]
#> [1] 3
a[c(1,2),2]
#> [1] 3 4
[行番号,] [, 列番号]でそれぞれ参照できるa[1,]
#> [1] 1 3
a[, 2]
#> [1] 3 4
a
#> [,1] [,2]
#> [1,] 1 3
#> [2,] 2 4
tmp <- a[2,1]
a[2,1] <- a[1,2]
a[1,2] <- tmp
a
#> [,1] [,2]
#> [1,] 1 2
#> [2,] 3 4
[も関数NAはNot Availablena_vec <- c(NA, NA, NA)
is.na(na_vec)
#> [1] TRUE TRUE TRUE
na_vec + 1
#> [1] NA NA NA
na_vec == 1
#> [1] NA NA NA
na_vec == NA
#> [1] NA NA NA
na_vec != NA
#> [1] NA NA NA
a <- readline("入力してね: ")
#> 入力してね: ここに入力
quiz <- function() {
answer <- "さくらんぼ"
ans_u <- readline("おうとうってなんだ?: ")
if (ans_u == answer) print("あってるよ")
else print("まちがってるよ")
}
quiz()
#> [1] "あってるよ"
| NULL | symbol | pairlist | closure |
| environment | promise | language | special |
| builtin | char | logical |
integer |
double |
complex |
character |
bytecode |
とか、他にもいっぱいあります。
#include "/usr/include/stdio.h"
#include "/usr/include/stdlib.h"
#include "/usr/include/string.h"
#include "/usr/include/R/R.h"
void quiz(char **ans_u);
void quiz(char **ans_u) {
char answer[] = "さくらんぼ";
char yes[] = "あってるよ";
char no[] = "まちがってるよ";
printf("おうとうってなんだ?: %p\n",*ans_u);
if(strcmp(answer,*ans_u) == 0) {
printf("%s",yes);
} else {
printf("%s",no);
}
}
gcc -shared -fPIC -I/usr/include/R -o quiz_point.so quiz_point.c
R CMD SHLIB quiz_point.c
dyn.load("./C/quiz_point.so")
ANS <- "さくらんぼ"
.C('quiz', as.character(ANS))
#> list()
#> おうとうってなんだ?: まちがってるよ
dyn.unload("./C/quiz_point.so")
R.hのinclude必要!?.Cでデータ型を確認する-I/usr/include/Rvoidにする。// プロトタイプ宣言
void hoge(ポインタ);
void hoge(ポインタ) {
}
.soか.dlldyn.load(“hoge.so”)で読み込むdyn.unload(“hoge.so”)でアンロード
.C('関数名',引数)か.Call()を使う#!/bin/sh
if [ $# -eq 1 ]
then
echo "おうとうってなんだ?"
R --vanilla --no-save --slave -f ./quiz_sh.R --args $1
else
echo "引数の数が正しくありません。"
fi
ans_u <- commandArgs(trailingOnly = TRUE)
diagnosis <- c("まちがってるよ\n",
"あってるよ\n")
cat( ans_u )
cat( "\n" )
cat(diagnosis[ (ans_u == "さくらんぼ") + 1 ])
chmod u+x quiz_sh.sh
trailingOnly = TRUEを指定する。
FALSEだとコマンドとオプションも渡される。--argsを指定する。.Rスクリプトを直接実行できる。#! /usr/bin/R --vanilla --no-save --slave -f
quiz <- function() {
answer <- "さくらんぼ"
ans_u <- readline("おうとうってなんだ?: ")
if (ans_u == answer) print("あってるよ")
else print("まちがってるよ")
}
quiz()
chmod u+x ファイル名
R --vanilla --no-save --slave << EOF
quiz <- function() {
answer <- "さくらんぼ"
ans_u <- readline("おうとうってなんだ?: ")
if (ans_u == answer) print("あってるよ")
else print("まちがってるよ")
}
quiz()
EOF
などなどいろいろ用意されている。
library(runr)
rb <- proc_ruby()
rb$start()
rb$exec("puts \"Hello World\" ")
#> puts "Hello World"
#> # Hello World
rb$stop()
install.packages()でインストールlibrary()で読み込み
require()を使う人もいる。detach()でアンロードinstall.packages("パッケージ名")
library(パッケージ名)
detach("package:パッケージ名", unload = TRUE)
R --no-save << EOF > logfile 2>&1
install.packages("パッケージ名")
EOF
%>%が使えるinstall.packages("tidyverse")
library(tidyverse)
library(tidyverse)
geom関数でプロットの形式を変えれるggsave()で簡単にプロットを保存できるmtcars_tibble <- as_tibble(mtcars)
ggplot(
data = mtcars_tibble,
mapping = aes(
x = mpg,
y = disp,
color = cyl
)
) +
geom_point()
+で関数をつなぐ
aes()で設定を行うggplot()に設定したものが全体の設定になる
ggplot()に設定するfunction()をつかう。{}でくくる。# a, b, c, d, e の五文字がいくつもあるデータ
# を想定している
pareto_func <- function(vec) {
res_count <- c("a" = NA, "b" = NA, "c" = NA, "d" = NA, "e" = NA)
for(moji in c("a", "b", "c", "d", "e")) {
res_count[moji] <- sum(vec == moji)
}
res_count <- sort(res_count, decreasing = TRUE)
res_pareto <- cumsum(res_count)
res_pareto <- res_pareto / res_pareto[5]
list("count" = res_count, "density" = res_pareto)
}
function(a = 5)のようにデフォルトも設定できるc("a" = NA)で名前を与えられる。
names(ベクトル)で名前を確認できる。sort()はならべかえsort(1:5, decreasing = FALSE)
#> [1] 1 2 3 4 5
sort(1:5, decreasing = TRUE)
#> [1] 5 4 3 2 1
cumsum()は累積和cumsum( c(1, 2, 3, 4, 5))
#> [1] 1 3 6 10 15
stringAsFactors = FALSEにする
read.csv("ファイル名", stringAsFactors = FALSE)
read_csv(
"ファイル名",
locale = locale(encoding = "エンコード")
)
row.names = FALSE
sample()runif()rnorm()rgamma()sample()で単純なデータを作成できるsizeは何個とりだすかreplaceは複数回とりだせるかprobは確率を指定する。
sample(1:100, size = 2)
#> [1] 24 13
| 関数 | 確率分布 | 使い方 |
|---|---|---|
runif() |
一様分布 | runif(5) |
rnorm() |
正規分布 | rnorm(5) |
rgamma() |
ガンマ分布 | rgamma(5,shape = 2, rate = 5) |
rbeta() |
ベータ分布 | rbeta(5, shape1 = 0.5, shape2 = 0.5) |
# 1から5を一つづつとってくる
prob_vec <- sample(1:5, size = 5)
# 1から5のうちから10000個分とってくる
# 確率は、1から5までで振り分けてある
vec1 <- sample(
1:5,
size = 10000,
replace = TRUE,
prob = prob_vec
)
# vec1の数を文字列に変える
replace_abcde <- function(vec1) {
num <- 1
for(moji in c("a", "b", "c", "d", "e")) {
vec1[vec1 == num] <- moji
num <- num + 1
}
assign("vec1", vec1, envir = parent.env(environment()))
}
replace_abcde(vec1)
result <- pareto_func(vec1)
result
#> $count
#> e a b c d
#> 3270 2674 2059 1326 671
#>
#> $density
#> e a b c d
#> 0.3270 0.5944 0.8003 0.9329 1.0000
result <- as_tibble(result) %>%
mutate(
name = names(result$count),
count_density = count / sum(count)
)
result %>%
ggplot() +
geom_hline(
yintercept = c(0.7,0.9,1),
size = 0.2,
color = "#ff0000"
) +
geom_bar(
aes(name, count_density, fill = density),
stat = "identity"
) +
geom_line(aes(name, density, group ="1")) +
geom_point(
aes(name, density, color = density),
size = 5
) +
scale_x_discrete(limits = result$name) +
scale_y_continuous(breaks = seq(0, 1, by = 0.1)) +
scale_color_gradient(low = "#006600", high = "#ccffcc") +
scale_fill_gradient(low = "#006600", high = "#ccffcc") +
# viridis::scale_fill_viridis(option="inferno") +
# viridis::scale_color_viridis() +
coord_cartesian(ylim = c(0,1)) +
labs(
x = names(result$count),
y = NULL
) +
theme(legend.position = "none")
# ggsave("pareto_graph.png")
モデリングに関しては、あつかわないので、 実際の統計手法とは異なることに注意してください。
あくまでも、例ですので
ToothGrowthというデータセットを使ってみるhead(ToothGrowth)
#> len supp dose
#> 1 4.2 VC 0.5
#> 2 11.5 VC 0.5
#> 3 7.3 VC 0.5
#> 4 5.8 VC 0.5
#> 5 6.4 VC 0.5
#> 6 10.0 VC 0.5
class(ToothGrowth)
#> [1] "data.frame"
VCかオレンジジュース(Oj)の用量と歯の長さToothGrowth2 <- as_tibble(ToothGrowth)
ToothGrowth2 %>% head() %>% knitr::kable()
| len | supp | dose |
|---|---|---|
| 4.2 | VC | 0.5 |
| 11.5 | VC | 0.5 |
| 7.3 | VC | 0.5 |
| 5.8 | VC | 0.5 |
| 6.4 | VC | 0.5 |
| 10.0 | VC | 0.5 |
ToothGrowth2 %>% tail() %>% knitr::kable()
| len | supp | dose |
|---|---|---|
| 24.8 | OJ | 2 |
| 30.9 | OJ | 2 |
| 26.4 | OJ | 2 |
| 27.3 | OJ | 2 |
| 29.4 | OJ | 2 |
| 23.0 | OJ | 2 |
names(ToothGrowth2) <- c("Tooth_length", "Supplement", "Dose")
ToothGrowth2 %>% head() %>% knitr::kable()
| Tooth_length | Supplement | Dose |
|---|---|---|
| 4.2 | VC | 0.5 |
| 11.5 | VC | 0.5 |
| 7.3 | VC | 0.5 |
| 5.8 | VC | 0.5 |
| 6.4 | VC | 0.5 |
| 10.0 | VC | 0.5 |
ToothGrowth2 %>%
ggplot(aes(Dose, Tooth_length, color = Supplement)) +
geom_point()
lm()を使うToothGrowth2_VC_lm <- lm(Tooth_length ~ Dose, data = ToothGrowth2 %>%
filter(Supplement == "VC"))
ToothGrowth2_OJ_lm <- lm(Tooth_length ~ Dose, data = ToothGrowth2 %>%
filter(Supplement == "OJ"))
ToothGrowth2_lm <- list(VC_lm = summary(ToothGrowth2_VC_lm),
OJ_lm = summary(ToothGrowth2_OJ_lm))
ToothGrowth2_lm$VC_lm$coefficients; ToothGrowth2_lm$OJ_lm$coefficients
#> Estimate Std. Error t value Pr(>|t|)
#> (Intercept) 3.29500 1.427060 2.308943 2.854201e-02
#> Dose 11.71571 1.078756 10.860392 1.509369e-11
#> Estimate Std. Error t value Pr(>|t|)
#> (Intercept) 11.550000 1.721951 6.707508 2.788784e-07
#> Dose 7.811429 1.301673 6.001070 1.824801e-06
# Tooth_length = 3.295 + 11.716 * Dose
# Tooth_length = 11.550 + 7.811 * Dose
geom_smoothのmethodを"lm"にするse = FALSEで標準誤差の表示をなくすToothGrowth2 %>%
group_by(Supplement) %>%
ggplot(aes(Dose, Tooth_length, color = Supplement)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE)
\[p^{\prime}(H \mid D) = \frac{p(D \mid H) * p(H)}{p(D)}\]
ToothGrowth2_VC_bayes_lm <- MCMCpack::MCMCregress(
Tooth_length ~ Dose,
ToothGrowth2 %>% filter(Supplement == "VC"),
verbose = 10000)
#>
#>
#> MCMCregress iteration 1 of 11000
#> beta =
#> 5.47369
#> 10.64170
#> sigma2 = 15.77352
#>
#>
#> MCMCregress iteration 10001 of 11000
#> beta =
#> 4.01607
#> 11.34625
#> sigma2 = 9.06792
ToothGrowth2_OJ_bayes_lm <- MCMCpack::MCMCregress(
Tooth_length ~ Dose,
ToothGrowth2 %>% filter(Supplement == "OJ"),
verbose = 10000)
#>
#>
#> MCMCregress iteration 1 of 11000
#> beta =
#> 14.17890
#> 6.51548
#> sigma2 = 22.96599
#>
#>
#> MCMCregress iteration 10001 of 11000
#> beta =
#> 12.42007
#> 7.36562
#> sigma2 = 13.20275
ToothGrowth2_bayes_lm <- list(
VC_bayes_lm = summary(ToothGrowth2_VC_bayes_lm),
OJ_bayes_lm = summary(ToothGrowth2_OJ_bayes_lm))
ToothGrowth2_bayes_lm
#> $VC_bayes_lm
#>
#> Iterations = 1001:11000
#> Thinning interval = 1
#> Number of chains = 1
#> Sample size per chain = 10000
#>
#> 1. Empirical mean and standard deviation for each variable,
#> plus standard error of the mean:
#>
#> Mean SD Naive SE Time-series SE
#> (Intercept) 3.312 1.487 0.01487 0.01452
#> Dose 11.703 1.127 0.01127 0.01127
#> sigma2 14.662 4.276 0.04276 0.04573
#>
#> 2. Quantiles for each variable:
#>
#> 2.5% 25% 50% 75% 97.5%
#> (Intercept) 0.4164 2.353 3.325 4.267 6.278
#> Dose 9.4136 10.978 11.702 12.423 13.927
#> sigma2 8.5478 11.647 13.928 16.818 24.859
#>
#>
#> $OJ_bayes_lm
#>
#> Iterations = 1001:11000
#> Thinning interval = 1
#> Number of chains = 1
#> Sample size per chain = 10000
#>
#> 1. Empirical mean and standard deviation for each variable,
#> plus standard error of the mean:
#>
#> Mean SD Naive SE Time-series SE
#> (Intercept) 11.571 1.794 0.01794 0.01752
#> Dose 7.796 1.360 0.01360 0.01360
#> sigma2 21.347 6.226 0.06226 0.06658
#>
#> 2. Quantiles for each variable:
#>
#> 2.5% 25% 50% 75% 97.5%
#> (Intercept) 8.077 10.413 11.586 12.723 15.15
#> Dose 5.034 6.922 7.795 8.665 10.48
#> sigma2 12.445 16.958 20.279 24.486 36.19
# Tooth_length = 3.312 + 11.703 * Dose
# Tooth_length = 11.571 + 7.796 * Dose
Intercept <- c(ToothGrowth2_bayes_lm$VC_bayes_lm$statistics[1,1],
ToothGrowth2_bayes_lm$OJ_bayes_lm$statistics[1,1])
slope <- c(ToothGrowth2_bayes_lm$VC_bayes_lm$statistics[2,1],
ToothGrowth2_bayes_lm$OJ_bayes_lm$statistics[2,1])
Intercept; slope
#> [1] 3.312116 11.570653
#> [1] 11.703262 7.796404
# Tooth_length = 3.312 + 11.703 * Dose
# Tooth_length = 11.571 + 7.796 * Dose
ToothGrowth2 %>%
group_by(Supplement) %>%
ggplot(aes(Dose, Tooth_length, color = Supplement)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE, size = 2) +
stat_function(
fun = function(Dose) Intercept[1] + slope[1] * Dose,
geom = "line",
color = "#00ffc4",
size = 0.6,
xlim = c(0.5, 2.0),
show.legend = TRUE
) +
stat_function(
fun = function(Dose) Intercept[2] + slope[2] * Dose,
geom = "line",
color = "#ffe4f1",
size = 0.5,
xlim = c(0.5, 2.0),
show.legend = TRUE
)
MCMCpackパッケージを使う。MCMCpack::MCMCregressでMCMC法での回帰直線を作成する。printで表示できる。MCMC法による線形回帰の結果を通常の線形回帰分析と重ねあわせてみると
\[\frac{p^{\prime} (H_{1} \mid D)}{p^{\prime}(H_0 \mid D)} = \frac{p(D \mid H_{1}) * p(H_{1})}{p(D \mid H_{0}) * p(H_{0})}\]
\[\frac{p(D \mid H_{1})}{p(D \mid H_{0})} = \frac{\frac{p^{\prime}(H_{1} \mid D)}{p(H_{1})}}{\frac{p^{\prime}(H_{0} \mid D)}{p(H_{0})}}\]
BayesFactor::anovaBF
# そのままやるとエラーになる
bf <- BayesFactor::anovaBF(
Tooth_length ~ Dose,
data = ToothGrowth2
)
#> Warning: data coerced from tibble to data frame
#> Error in createDataTypes(formula, whichRandom, data, analysis = "anova"): anovaBF() cannot be used with nonfactor independent variables. Use lmBF(), regressionBF(), or generalTestBF() instead.
ToothGrowth2$Dose <- factor(ToothGrowth2$Dose)
levels(ToothGrowth2$Dose) <- c("Low", "Medium", "High")
bf <- BayesFactor::anovaBF(
Tooth_length ~ Supplement * Dose,
data = ToothGrowth2
)
#> Warning: data coerced from tibble to data frame
#>
|
| | 0%
|
|================ | 25%
|
|================================ | 50%
|
|================================================= | 75%
|
|=================================================================| 100%
bf
#> Bayes factor analysis
#> --------------
#> [1] Supplement : 1.198757 ±0.01%
#> [2] Dose : 4.983636e+12 ±0%
#> [3] Supplement + Dose : 2.776051e+14 ±1.05%
#> [4] Supplement + Dose + Supplement:Dose : 7.855115e+14 ±1.95%
#>
#> Against denominator:
#> Intercept only
#> ---
#> Bayes factor type: BFlinearModel, JZS
bf[3:4] / bf[2]
#> Bayes factor analysis
#> --------------
#> [1] Supplement + Dose : 55.70333 ±1.05%
#> [2] Supplement + Dose + Supplement:Dose : 157.6181 ±1.95%
#>
#> Against denominator:
#> Tooth_length ~ Dose
#> ---
#> Bayes factor type: BFlinearModel, JZS
plot()を使うplot(bf)
plot(bf[3:4]/bf[2])
Supplementは関係なさそうSupplement + Dose + Supplement:Doseで仮設を立てるのが最も良さそうというわけでfactorをnumericにするんですが 少し失敗しました。笑
levels(ToothGrowth2$Dose) <- c(0.5, 1, 2)
ToothGrowth2$Dose <- as.numeric(as.character(ToothGrowth2$Dose))
str(ToothGrowth2$Dose)
#> num [1:60] 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 ...
# Tooth_length = b0 + b1*Supplement + b2*Dose + b3*Supplement*Dose
ToothGrowth_lm_result <- lm(Tooth_length ~ Supplement * Dose, data = ToothGrowth2)
summary(ToothGrowth_lm_result)
#>
#> Call:
#> lm(formula = Tooth_length ~ Supplement * Dose, data = ToothGrowth2)
#>
#> Residuals:
#> Min 1Q Median 3Q Max
#> -8.2264 -2.8462 0.0504 2.2893 7.9386
#>
#> Coefficients:
#> Estimate Std. Error t value Pr(>|t|)
#> (Intercept) 11.550 1.581 7.304 1.09e-09 ***
#> SupplementVC -8.255 2.236 -3.691 0.000507 ***
#> Dose 7.811 1.195 6.534 2.03e-08 ***
#> SupplementVC:Dose 3.904 1.691 2.309 0.024631 *
#> ---
#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#>
#> Residual standard error: 4.083 on 56 degrees of freedom
#> Multiple R-squared: 0.7296, Adjusted R-squared: 0.7151
#> F-statistic: 50.36 on 3 and 56 DF, p-value: 6.521e-16
ToothGrowth2 <- ToothGrowth2 %>%
mutate(
Supplement_num = unclass(.$Supplement),
Tooth_length_res = predict(ToothGrowth_lm_result)
)
ToothGrowth2 %>% head() %>% knitr::kable()
| Tooth_length | Supplement | Dose | Supplement_num | Tooth_length_res |
|---|---|---|---|---|
| 4.2 | VC | 0.5 | 2 | 9.152857 |
| 11.5 | VC | 0.5 | 2 | 9.152857 |
| 7.3 | VC | 0.5 | 2 | 9.152857 |
| 5.8 | VC | 0.5 | 2 | 9.152857 |
| 6.4 | VC | 0.5 | 2 | 9.152857 |
| 10.0 | VC | 0.5 | 2 | 9.152857 |
par(mfrow = c(2, 2))
plot(ToothGrowth_lm_result)
ToothGrowth2 %>%
ggplot(aes(Dose, color = Supplement)) +
geom_point(aes(y = Tooth_length_res) ,
position = position_jitter(width = 0.1, height = 1),
color = "#0000ff") +
geom_point(aes(y = Tooth_length) ,
position = position_jitter(width = 0.1)
) +
facet_wrap(~ Supplement)
b3 * Supplement * Doseが棄却される。install.packages(c("bitops", "caTools"))
---
title: "たいとる"
author: "書いた人"
date: "日付"
output: 出力形式:
css: "cssのパス"
self_contained: TRUEかFALSE
---
self_containedは、jsとかをまとめるかどうか
TRUEを使う| 指定方法 | 出力形式 |
|---|---|
| html_document | html |
| pdf_document | |
| word_document | word |
| ioslides_presentation | htmlのスライド |
| revealjs::revealjs_presentation | イケてるスライド |
| bookdown::gitbook | 本 |
bookdownは、今回の資料で使った形式
pdf_bookやepub_bookがある#CRANから
install.packages("revealjs")
#githubから
install.packages("devtools")
devtools::install_github("rstudio/revealjs")
install.packages("bookdown")
output: pdf_document
Ctrl + Shift + K (knit)
! LaTeX Error: File `titling.sty' not found. ! ==> Fatal error occurred, no output PDF file produced!
titling.styがないということPackage microtype Warning: You don't seem to be using pdftex, luatex or xetex. (microtype) `microtype' only works with these engines. (microtype) I will quit now. ) ! Package microtype Error: The protrusion set `basicmath' is undeclared. (microtype) Using set `\MT@default@pr@set ' instead.
microtypeはpdftex, luatex, xetexでしか働かないtexライブラリを追加すればOK
wgetを使う場合は、CTANで必要なzipのURLを取得してください
wget ftp://ftp.jaist.ac.jp/pub/CTAN/macros/latex/contrib/titling.zip
unzip titling.zip
cd titling.zip
latex titling.ins
sudo cp titling.sty /usr/share/texlive/texmf-dist/tex/latex/titling/
sudo texhash
# You are recommended to install the tinytex package to build PDF.FALSE
On Rstudio
install.packages("tinytex")
yum, aptでもいけるsudo yum install texlive-*
sudo apt-get install texlive-*
includesでパッケージを指定できる
\usepackageの部分は無視してください
---
output: pdf_document:
latex_engine: lualatex
header-includes:
- \usepackage[utf-8]{inputenc} //絶対やらないでくださいハマります
---
---
output:
html_document:
include:
in_header: ファイル名
before_body: ファイル名
after_body: ファイル名
pdf_document:
includes:
in_header: preamble.tex
before_body: before_body.tex
after_body: after_body.tex
latex_engine: xelatex
---
\```{r}
\Rのコード
\```
Ctrl + Alt + I でチャンクを追加できる{r チャンク名, オプションの指定}| オプション | T, F | 結果 |
|---|---|---|
| include | FALSE | コードと結果を表示しない |
| echo | FALSE | コードを表示しない |
| message | FALSE | メッセージを表示しない |
| eval | FALSE | 実行しない |
knitr::opts_chunk$get{r setup, include = FALSE}include = FALSEがよく使う指定。
\```{r setup, include=FALSE}
knitr::opts_chunk$set(
comment = "#>",
collapse = TRUE,
fig.show = "hold"
)
\```
$数式$$$数式$$たとえば,\(E=mc^2\), \(mgh=\frac{1}{2}mv^2\)
\[E=mc^2\] \[mgh=\frac{1}{2}mv^2\]
| コマンド | 効果 |
|---|---|
\text |
演算子など記号を文字にする |
{\rm } |
文字がイタリックになるのをやめる |
_{} |
下付き文字 |
^{} |
上付き文字 |
\theta |
\(\theta\)ギリシャ文字(ほかにも使えます) |
\frac{a}{b} |
\(\frac{a}{b}\)の分数をつくる |
\int_a^b |
\(\int_a^b\)こんな感じの積分を作る |
shinyserverproを使うとユーザー認証ができたりする。
eval=FALSEにしてある
簡単に書いてみると
ui <- fluidPage(
titlePanel("たいとる"),
mainPanel(),
sidebarPanel()
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
shinyUI()でui設定を{}でくくって記述shinyServer()でserver設定をfunction(input,output){}の関数内で記述ui,serverオブジェクトを定義shinyApp(ui = ui, server = server)でアプリ起動ls(envir = environment(shiny::numericInput)) %>%
# ..*で任意の一文字以上, (Input|Output)でInputまたはOutput, $は行末のアンカー
str_subset("..*(Input|Output)$")
#> [1] "cancelOutput" "checkboxGroupInput"
#> [3] "checkboxInput" "dataTableOutput"
#> [5] "dateInput" "dateRangeInput"
#> [7] "fileInput" "htmlOutput"
#> [9] "imageOutput" "numericInput"
#> [11] "passwordInput" "plotOutput"
#> [13] "restoreInput" "selectInput"
#> [15] "selectizeInput" "serializerFileInput"
#> [17] "sliderInput" "snapshotPreprocessInput"
#> [19] "snapshotPreprocessorFileInput" "snapshotPreprocessOutput"
#> [21] "tableOutput" "textAreaInput"
#> [23] "textInput" "textOutput"
#> [25] "uiOutput" "updateCheckboxGroupInput"
#> [27] "updateCheckboxInput" "updateDateInput"
#> [29] "updateDateRangeInput" "updateNumericInput"
#> [31] "updateSelectInput" "updateSelectizeInput"
#> [33] "updateSliderInput" "updateTextAreaInput"
#> [35] "updateTextInput" "verbatimTextOutput"
ui <- fluidPage(
titlePanel("numericInput&sliderInput"),
fluidRow(
column(6,
numericInput("test_num", "数字を入力してね", value = NA, min = 0, max = 20)),
column(6,
sliderInput("test_slide", "スライドしよう", min = 0, max = 100, value = 20))
),
textOutput("test_text")
)
server <- function(input, output) {
output$test_text <- renderText({
paste0("入力した数字は,", input$test_num, "スライダーの数字は,", input$test_slide)
})
}
shinyApp(ui = ui, server = server)
output$id名に出力を代入する。
render系の関数は出力時に使う。
ls(envir = environment(shiny::renderText)) %>%
str_subset(".*render.*")
#> [1] "as.tags.shiny.render.function" "knit_print.shiny.render.function"
#> [3] "renderDataTable" "renderImage"
#> [5] "renderPage" "renderPlot"
#> [7] "renderPrint" "renderReactLog"
#> [9] "renderTable" "renderText"
#> [11] "renderUI"
render*はinputの値が変わるたびに、再実行する。numericInputの値しか変わらないのにsliderInputの値を再代入してしまう。reactive()を使おう!
ui <- fluidPage(
titlePanel("numericInput&sliderInput"),
fluidRow(
column(6,
numericInput("test_num", "数字を入力してね", value = NA, min = 0, max = 20)),
column(6,
sliderInput("test_slide", "スライドしよう", min = 0, max = 100, value = 20))
),
textOutput("test_text")
)
server <- function(input, output) {
reactive_test_num <- reactive(list(input$test_num, input$test_slide))
output$test_text <- renderText({
paste0("入力した数字は,", reactive_test_num()[[1]], "スライダーの数字は,", reactive_test_num()[[2]])
})
}
shinyApp(ui = ui, server = server)
reactiveは関数オブジェクトの形をとる。[[]]でのアクセスは、ベクトルを返させる。
reactiveの関数は、{}でくくると複数行の表現式を受け取れる。reactiveは、メモリ中のinput変数が変わったら、再実行される。
なんども関数を実行することは速度の低下につながる。
observeは常にinputを監視する。reactiveと同じ。ui <- fluidPage(
titlePanel("numericInput&sliderInput"),
fluidRow(
column(6,
numericInput("test_num", "数字を入力してね", value = NA, min = 0, max = 20)),
column(6,
sliderInput("test_slide", "スライドしよう", min = 0, max = 100, value = 20))
),
textOutput("test_text")
)
server <- function(input, output) {
#observe(list(input$test_num, input$test_slide))
observe_test <- reactiveValues()
observe({observe_test$num <- input$test_num; observe_test$slide <- input$test_slide})
output$test_text <- renderText({
paste0("入力した数字は,",
#input$test_num,
observe_test$num,
"スライダーの数字は,",
#input$test_slide
observe_test$slide)
})
}
shinyApp(ui = ui, server = server)
observe()は,reactiveと決定的に違う。inputが変わらなくても、observe内の関数を再実行する。
render*内の関数を外に押し出すのにいいかも。observe()が監視するのは、reacitveな表現式(オブジェクト)reactiveValues()は、reactiveなオブジェクトを生成する
render*の関数mermaid("
graph LR
id1[reactive]
id2{observer}
id3>endpoint]
id1---id2
id2---id3")
render*でoutputにわたす
renderText()をさっき使ったmermaid()は後述ui <- fluidPage(
titlePanel("numericInput&sliderInput"),
fluidRow(
column(6,
numericInput("test_num", "数字を入力してね", value = NA, min = 0, max = 20)),
column(6,
sliderInput("test_slide", "スライドしよう", min = 0, max = 100, value = 20))
),
dataTableOutput("test_table")
)
server <- function(input, output) {
check_var <- reactive(data.frame(num = input$test_num, slide = input$test_slide))
DT <- reactiveValues(table_1 = NA)
# 直接 table_1 に代入すると
# reactiveじゃないのでエラーになる
#observe(table_1 <- as.data.frame(check_var()))
observe(DT$table_1 <- as.data.frame(check_var()))
# output$test_table <- renderDataTable({as.data.frame(check_var())})
output$test_table <- renderDataTable(DT$table_1)
}
shinyApp(ui = ui, server = server)
renderDataTable()はdata.frameとmatrixを出力renderTable()はxtable::xtableを使うので注意!?shiny::renderDataTable*Panelで書けばいい。sidebarLayout()も簡単ls(envir = environment(shiny::titlePanel)) %>%
str_subset(".*Panel$")
#> [1] "absolutePanel" "conditionalPanel" "fixedPanel"
#> [4] "headerPanel" "inputPanel" "mainPanel"
#> [7] "navlistPanel" "sidebarPanel" "tabPanel"
#> [10] "tabsetPanel" "titlePanel" "updateNavlistPanel"
#> [13] "updateTabsetPanel" "wellPanel"
fluidRow()の中にcolumn(width, )でレイアウトしていく
column(width, )のwidthは,同一のfluidRow()内で合計12になるようにする。
width = 6width = 4width = 2, width = 4 , width = 6もOKshiny::includeCSS()でcssファイルを指定する。(パス無し)
wwwディレクトリをapp.R, ui.R, server.Rのあるところに作るwww内にcssファイルを置くfluidPage(theme = "css", )で指定する。tags$head()内のtags$link()で設定する
tags$head()内のtags$style()で直接スタイルを書く
h1, h2, h3 {
color: red;
font-size: 10em;
}
body {
background-color: grey;
}
ui <- fluidPage(
#失敗,たぶんリポジトリのディレクトリ構造が干渉してる
# theme = "shiny_css/test_shiny_css.css",
#失敗,たぶん上と同じ理由
# tags$head(
# tags$link(rel = "stylesheet", type = "text/css", href = "shiny_css/test_shiny_css.css")
# ),
#これはうまくいく。パスはRmd起点にしてある。
#includeCSS("www/shiny_css/test_shiny_css.css"),
headerPanel("numericInput&sliderInput"),
fluidRow(
column(6,
numericInput("test_num", "数字を入力してね", value = NA, min = 0, max = 20)),
column(6,
sliderInput("test_slide", "スライドしよう", min = 0, max = 100, value = 20))
),
dataTableOutput("test_table")
)
server <- function(input, output) {
check_var <- reactive(data.frame(num = input$test_num, slide = input$test_slide))
DT <- reactiveValues(table_1 = NA)
observe({DT$table_1 <- as.data.frame(check_var())})
output$test_table <- renderDataTable(DT$table_1)
}
shinyApp(ui = ui, server = server)
@importするui <- fluidPage(
tags$head(
tags$style(HTML("
/*
@import url(//fonts.googleapis.com/earlyaccess/nicomoji.css);
h1, h2, h3, h4, h5, h6, p {
font-family: 'Nico Moji', cursive;
}
*/
/*
@import url(//fonts.googleapis.com/earlyaccess/hannari.css);
h1, h2, h3, h4, h5, h6, p {
font-family: 'Hannari', serif;
}
*/
"))
),
headerPanel("数字の入力練習"),
fluidRow(
column(6,
numericInput("test_num", "数字を入力してね", value = NA, min = 0, max = 20)),
column(6,
sliderInput("test_slide", "スライドしよう", min = 0, max = 100, value = 20))
),
dataTableOutput("test_table")
)
server <- function(input, output) {
check_var <- reactive(data.frame(num = input$test_num, slide = input$test_slide))
output$test_table <- renderDataTable({as.data.frame(check_var())})
}
shinyApp(ui = ui, server = server)
leafletとDiagrammeRを紹介DiagrammeR# ダブルクウォーテーションを使う場合
mermaid('
graph LR
first["leaflet()"]
second["addTiles()"]
last[他の情報]
first --> second
second --> last')
map_df <- data.frame(
popup = c("はこだて", "函館駅", "新函館北斗駅", "MIRAI BASE"),
lng = c(140.72881, 140.7277, 140.648376, 140.757159),
lat = c(41.768793, 41.773269, 41.904698, 41.814461)
)
# 函館駅と新函館北斗駅を結ぶ
leaflet() %>%
addTiles() %>%
addMarkers(lng = map_df$lng[2:3], lat = map_df$lat[2:3], popup = map_df$popup[2:3]) %>%
addPolylines(lng = map_df$lng[2:3], lat = map_df$lat[2:3])
leaflet()とaddTiles()でマップを用意addMarkersでマークする
addPolylines()で直線を引くleafletには用意されてない。rMapsを使う。
rChartsが依存関係R --no-save << EOF > install_rCharts.log 2>&1
devtools::install_github("rmnathv/rCharts")
EOF
R --no-save << EOF > install_rMaps.log 2>&1
devtools::install_github("rmnathv/rMaps")
EOF
library(rMaps); library(leaflet)
map <- Leaflet$new()
map$setView(c(map_df$lat[1], map_df$lng[1]), zoom = 15)
#map$marker(c(map_df$lat[2], map_df$lng[2]), bindpopup = map_df$popup[2])
#map$marker(c(map_df$lat[4], map_df$lng[4]), bindpopup = map_df$popup[4])
map$addAssets(css = c("https://unpkg.com/leaflet@1.2.0/dist/leaflet.css", "https://unpkg.com/leaflet-routing-machine@latest/dist/leaflet-routing-machine.css"),
jshead = c("https://unpkg.com/leaflet-routing-machine@latest/dist/leaflet-routing-machine.js", "https://unpkg.com/leaflet@1.2.0/dist/leaflet.js"))
map$setTemplate(afterScript = sprintf("
<script>
L.Routing.control({
waypoints: [
L.latlng(41.77327, 140.7277),
L.latlng(41.81446, 140.7572)
]
}).addTo(map);
</script>
"))
map
leafletのインストール時にエラーが出る場合がある。/bin/sh: libpng-config: command not found
read.c:3:17: 致命的エラー: png.h: No such file or directory
#include <png.h>
ERROR: compilation failed for package ‘png’
# 失敗
sudo yum install libpng-config
# 失敗
sudo yum install libpng.x86_64
# 成功
wget http://prdownloads.sourceforge.net/libpng/libpng-1.6.34.tar.gz
tar zxvf libpng-1.6.34.tar.gz
cd libpng-1.6.34
./configure
make
sudo make install
export CPLUS_INCLUDE_PATH=/usr/local/include
export LD_LIBRARY_PATH=/usr/local/lib
export LIBRARY_PATH=/usr/local/lib
R --no-save << EOF > install_png.log 2>&1
install.packages("png")
EOF
R --no-save << EOF > install_leaflet.log 2>&1
install.packages("leaflet")
EOF
graphvizとmermaidが主力grViz("
digraph prac_grviz {
//グラフ全体の設定
graph [ rankdir = LR ]
//ノードの設定
node []
a; b; c;
//エッジの設定
edge []
a -> b -> c
}
")
//, /* */, # が使える。digraph グラフ名 { グラフの情報 }で書く->で有向, --で無向
graph[]でグラフ全体の設定をする
rankdirは全体の方向を設定する
TB, LRはそれぞれ
grViz("
digraph gogyo {
graph [ charset = 'UTF-8' ]
node [ shape = 'circle']
a [ label = '木' ];
b [ label = '火' ];
c [ label = '土' ];
d [ label = '金' ];
e [ label = '水' ];
edge []
a -> b -> c -> d -> e [ arrowhead = 'none' ]
a -> c -> e -> b -> d -> a
}
")
graph [ charset = '文字コード' ]で文字コードを設定する。
[label = 'なまえ']で表示する名前を書きます。[shape = 'circle']でノードの形を設定します。[arrowtail = 'none', arrowhead = 'none']でエッジの設定をします。
五行を書いてみたのですが、全然綺麗じゃないですね。
grViz("
digraph gogyo_resetting {
graph [ charset = 'UTF-8',
rankdir = TB,
// layout = dot
// layout = neato
// layout = twopi
layout = circo
]
node [ shape = 'circle',
width = 0.9 ]
a [ label = '木' ];
b [ label = '火' ];
c [ label = '土' ];
d [ label = '金' ];
e [ label = '水' ];
edge []
a -> b -> c -> d -> e [ arrowhead = 'none' ]
a -> c -> e -> b -> d -> a
{rank = min; a;}
{rank = same; b; e;}
{rank = max; c; d;}
}
")
調整がかなり難しい。
layoutはいろいろある
dotはデフォルトcirco, neato, twopi, fdp, sfdp, osage{rank = min; node;}は、ノードの優先順位を決める
grViz("
digraph c_pointer {
graph [
charset = 'UTF8',
rankdir = LR,
newrank = true,
compound = true
]
node [
shape = 'box'
]
subgraph cluster_a {
label = '003'
/*
// 003
003 [ label = '@@1-1' ]
*/
// a
a [ label = '@@1-1' ]
}
// *a
pointer_pointer [ label = '@@1-2' ]
// **a
base_pointer_pointer [ label = '@@1-3' ]
subgraph cluster_b {
label = '002'
/*
// 002
002 [ label = '@@2-1' ]
*/
// b
b [ label = '@@2-1' ]
}
// *b
base_pointer [ label = '@@2-2' ]
subgraph cluster_c {
label = '001'
/*
// 001
001 [ label = '@@3-1' ]
*/
// c\\n114
c [ label = '@@3-1' ]
// base [ label = '114' ]
}
a -> b [ lhead = cluster_b, color = red ];
b -> c [ lhead = cluster_c,arrowtail = diamond, color = red]
pointer_pointer -> b
base_pointer_pointer -> c
base_pointer -> c
{rank = same; a; pointer_pointer; base_pointer_pointer;}
{rank = same; b; base_pointer;}
{rank = same; c;}
}
[1]: c( 'a\\n002', '*a\\n001', '**a\\n114')
[2]: c( 'b\\n001', '*b\\n114')
[3]: c( 'c\\n114')
")
subgraphでサブグラフを設定できる
cluster_*で名前の最初にcluster_をつける@@の後に数字をつける@@1-1みたいにすると複数のfootnumberをつけれる[footnumber]:で属性を設定できるgraph graph_name {}の外はRの表現を使える
Rの表現式でのエスケープとhtmlにわたす改行文字の表現で\\nとなる
mermaidというグラフ生成方法もあるmermaid("
graph LR
id1[四角]
id2(角丸)
id3{ダイヤ}
id4>よこっちょ削り]
id5((円))
id1 --- id2
id2 --> id3
id3 ---|こっち| id4
id3 --円だよ--> id5
")
graphは通常のグラフ
LR, RL, TB(TD), BTで全体の方向を指定""でくくる
そのため、mermaid('グラフ')で全体をくくる
| 無向 | 有向 | 効果 |
|---|---|---|
--- |
--> |
ふつう |
-.- |
-.-> |
ドット |
=== |
==> |
太い |
---|hoge| |
-->|hoge| |
テキストつき |
-- hoge --- |
-- hoge --> |
テキストつき |
-.->|hoge| |
-. hoge .-> |
テキストつきドット |
mermaid("
sequenceDiagram
participant aomori as 新青森
participant kikonai as 木古内
participant hokuto as 新函館北斗
participant hakodate as 函館
aomori->>kikonai: 新幹線
kikonai->>hokuto: 新幹線
hokuto--xhakodate: 新幹線
hokuto->>hakodate: JR
Note over aomori,kikonai: 青函トンネル
")
sequenceDiagramを書くparticipant 名前で各シーケンスの名前を設定
participant id as 名前でid名で扱えるようになる。(エイリアス)エッジ: テキストでテキストを入れられるNote 配置 Actor: テキストでメモを入れられる。
left of, right of, over| 無向 | 有向 | ばってん | 効果 |
|---|---|---|---|
-> |
->> |
-x |
ふつう |
--> |
-->> |
--x |
点線 |
mermaid("
gantt
title 基本情報
dateFormat YYYY-MM-DD
section 午前問題
テキスト読み込み :done, text, 2017-12-01, 30d
午前の過去問 :done, kako_1, after text, 90d
section 午後問題
C言語 :done, Clang, 2018-02-01, 60d
午後の過去問 :done, kako_2, 2018-02-01, 60d
section 試験日程
fe :crit, done, test, 2018-04-15, 1d
合格発表 : done, pass, 2018-05-16, 1d
section 合格発表後
IEEEEEEEEEEE :active, IEEE, 2018-05-16, 10d
")
?render_graphを参考にしています。create_graph() %>%
# 均等なツリーをつくる
add_balanced_tree(
# kは分岐の数, hは深度
k = 2, h = 3) %>%
render_graph()
create_graph()でグラフのもとを作るadd_balanced_tree()で均等なツリーをグラフに追加するrender_graph()でグラフの情報をレンダリングするcreate_graph() %>%
add_balanced_tree(
k = 2, h = 3) %>%
# layoutで構造をしていする
render_graph(layout =
"nicely" #default
#"tree" #ツリー
#"circle" #円
#"kk" #defaultのぎゅっとしたやつ
#"fr" #defaultの点対称っぽい
)
render_graph()で最終的なグラフの出力を指定するcreate_graph() %>%
add_balanced_tree(
k = 2, h = 3) %>%
# ノードのラベルを剥がす attr=NULL, nodes=NULL
set_node_attr_to_display() %>%
render_graph(layout = "circle")
set_node_attr_to_display()のデフォルト引数が
attr=NULL, nodes=NULLcreate_graph() %>%
# graphのノード(n)とエッジ(m)を設定する
# 乱数でノードとエッジを決めているようなのでset_seedを設定する
add_gnm_graph(n = 60, m = 5
#, set_seed = 1
) %>%
render_graph(layout = "circle")
add_gnm_graph()は、ノードとエッジを生成する
set_seedで再現性を保つcreate_graph() %>%
add_balanced_tree(
k = 2, h = 3) %>%
# output = NULLでgrVizを利用してレンダリングされる
# output = "visNetwork"でvisnetworkを利用してレンダリングされる
render_graph(output = "visNetwork")
output = "visNetwork"とした場合はDiagrammeR::visnetwork()が呼び出される
graphのみなので、グラフに予め情報をセットしておく公式のドキュメントが更新されるのを待ちたい。
trav_out(), trav_in(), trav_both()を中心に説明していく
trav_out()は、元のノードから外のノードとのつながりtrav_in()は、外から内側へのつながりtrav_both()は、真ん中から内側と外側へのつながりgraph_1_2 <- create_graph() %>%
add_node() %>%
add_node() %>%
add_edge(1, 2)
graph_1_2 %>% render_graph()
graph_1_2 %>%
select_nodes_by_id(1) %>%
trav_out() %>%
get_selection()
#> `select_nodes_by_id()` INFO: created a new selection of 1 node
#> `get_selection()` INFO: there is an active selection of 1 node
#> [1] 2
select_nodes_by_id()で選択したノードからtrav_out()で外側に動くgraph_2_1 <- create_graph() %>%
add_node %>%
add_node %>%
add_edge(from = 2, to = 1)
graph_2_1 %>% render_graph()
graph_2_1 %>%
select_nodes_by_id(1) %>%
trav_out() %>%
get_selection()
#> `select_nodes_by_id()` INFO: created a new selection of 1 node
#> `get_selection()` INFO: there is an active selection of 1 node
#> [1] 1
trav_out()は外側のnode1に向かって動くtrav_in()を使うとnode2に向かって動くgraph_2_1 %>% select_nodes_by_id(1) %>%
trav_in() %>%
get_selection()
#> `select_nodes_by_id()` INFO: created a new selection of 1 node
#> `get_selection()` INFO: there is an active selection of 1 node
#> [1] 2
poly_node <- create_graph() %>%
add_n_nodes(5) %>%
add_edge_df(create_edge_df(c(1,2,3,4), c(2,3,4,5)))
poly_node %>% render_graph(layout = "kk")
poly_node %>%
select_nodes_by_id(1) %>%
trav_out() %>%
# 2
trav_out() %>%
# 3
trav_out() %>%
# 4
trav_out() %>%
# 5
get_selection()
#> `select_nodes_by_id()` INFO: created a new selection of 1 node
#> `get_selection()` INFO: there is an active selection of 1 node
#> [1] 5
graph_center_1 <- create_graph() %>%
add_node() %>% # ノードがひとつだけのグラフ
select_nodes_by_id(1) %>%
add_n_nodes_ws(10, "from", type = "from_nodes") %>% # ノード1から
add_n_nodes_ws(10, "to", type = "to_nodes") # ノード1に向かって
#> `select_nodes_by_id()` INFO: created a new selection of 1 node
graph_center_1 %>% render_graph(layout = "tree")
graph_center_1 %>%
trav_out() %>%
get_selection()
#> `get_selection()` INFO: there is an active selection of 10 nodes
#> [1] 2 3 4 5 6 7 8 9 10 11
select_nodes_by_id()でノードが選択される
add_n_nodes_ws()で選択したノードからノードをどっち向きに増やすかを決める
direction引数は、"from"か"to"のどっちかtrav_out()は、外側に向かうgraph_center_1 %>%
trav_in() %>%
get_selection()
#> `get_selection()` INFO: there is an active selection of 10 nodes
#> [1] 12 13 14 15 16 17 18 19 20 21
trav_bothをつかうと
graph_center_1 %>%
trav_both() %>%
get_selection()
#> `get_selection()` INFO: there is an active selection of 20 nodes
#> [1] 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
trav_*のconditions引数でフィルタリングできる
conditionsには、条件式を入れる#乱数使われているみたい
graph <-
create_graph() %>%
add_n_nodes(
n = 1,
type = "a",
label = "a"
) %>%
add_n_nodes(
n = 4,
type = "b",
label = "b"
) %>%
add_n_nodes(
n = 4,
type = "c",
label = "c"
) %>%
add_edges_w_string(
edges = "1->2 1->3 4->1 5->1 1->6 1->7 8->1 9->1"
)
# View the created graph
render_graph(graph, output = "visNetwork")
add_n_nodes()でノードを追加する
nはノード数typeは、文字ベクトルを入れる
add_n_nodes(n = 4, type = "c")はadd_edges_w_string()でエッジの方向を指定する
# さっきのグラフを更新する
update_graph <- graph %>%
select_nodes_by_id(nodes = 1) %>%
trav_out(conditions = type == "c") %>%
add_n_nodes_ws(1, direction = "from", type = "d", label = "d")
#> `select_nodes_by_id()` INFO: created a new selection of 1 node
render_graph(update_graph, output = "visNetwork")
select_nodes_by_id(nodes = 1)でノード1を選択trav_out(conditions = type == "c")で
add_n_nodes_ws()で2つのノードそれぞれから1個ずつノードを追加するnodes <-
create_node_df(
n = 9,
type = c("fruit", "fruit", "fruit",
"veg", "veg", "veg",
"nut", "nut", "nut"),
label = c("pineapple", "apple",
"apricot", "cucumber",
"celery", "endive",
"hazelnut", "almond",
"chestnut"))
edges <-
create_edge_df(
from = c(9, 3, 6, 2, 6, 2, 8, 2, 5, 5),
to = c(1, 1, 4, 3, 7, 8, 1, 5, 3, 6))
graph <-
create_graph(
nodes_df = nodes,
edges_df = edges)
render_graph(graph, output = "visNetwork")
graph %>%
get_node_info()
#> id type label deg indeg outdeg loops
#> 1 1 fruit pineapple 3 3 0 0
#> 2 2 fruit apple 3 0 3 0
#> 3 3 fruit apricot 3 2 1 0
#> 4 4 veg cucumber 1 1 0 0
#> 5 5 veg celery 3 1 2 0
#> 6 6 veg endive 3 1 2 0
#> 7 7 nut hazelnut 1 1 0 0
#> 8 8 nut almond 2 1 1 0
#> 9 9 nut chestnut 1 0 1 0
graph %>%
select_nodes(
# aではじまる(正規表現^は先頭を表すアンカー)
conditions = stringr::str_detect(graph$nodes_df$label, "^a")) %>%
trav_out() %>%
get_selection()
#> `select_nodes()` INFO: created a new selection of 3 nodes`()` INFO: created a new selection of 3 nodes
#> `get_selection()` INFO: there is an active selection of 4 nodes
#> [1] 1 3 5 8
stringr::str_detectで論理値を受け取るtrav_out()でそれぞれの外側を選択trav_*の比較演算子の説明で使われていたものset_node_attrs()で、ノードの大きさを設定しているrandom_graph <-
create_graph(directed = TRUE) %>%
add_gnm_graph(n = 5, m = 10, set_seed = 20) %>%
set_node_attrs(node_attr = "value", values = c(9, 8, 3, 5.5, 10))
random_graph %>% get_node_df()
#> id type label value
#> 1 1 <NA> 1 9.0
#> 2 2 <NA> 2 8.0
#> 3 3 <NA> 3 3.0
#> 4 4 <NA> 4 5.5
#> 5 5 <NA> 5 10.0
random_graph %>% get_edge_df()
#> id from to rel
#> 1 1 1 5 <NA>
#> 2 2 1 3 <NA>
#> 3 3 2 1 <NA>
#> 4 4 2 5 <NA>
#> 5 5 2 3 <NA>
#> 6 6 3 4 <NA>
#> 7 7 4 5 <NA>
#> 8 8 5 1 <NA>
#> 9 9 5 2 <NA>
#> 10 10 5 4 <NA>
render_graph(random_graph, output = "visNetwork")
trav_*_edge()をつかうnodes <-
create_node_df(
n = 14,
type = c("person", "person",
"person", "person",
"person", "fruit",
"fruit", "fruit",
"veg", "veg", "veg",
"nut", "nut", "nut"),
label = c("Annie", "Donna",
"Justine", "Ed",
"Graham", "pineapple",
"apple", "apricot",
"cucumber", "celery",
"endive", "hazelnut",
"almond", "chestnut"))
edges <-
create_edge_df(
from = sort(
as.vector(replicate(5, 1:5))),
to = as.vector(
replicate(5, sample(6:14, 5))),
rel = as.vector(
replicate(
5, sample(
c("likes", "dislikes","allergic_to"),
5,
TRUE,
c(0.5, 0.25, 0.25)
)
)
)
)
graph <-
create_graph(
nodes_df = nodes,
edges_df = edges
)
graph %>% render_graph(output = "visNetwork")
set.seed(20)
graph <-
create_graph(directed = TRUE) %>%
add_gnm_graph(10, 20,
set_seed = 20)
for(i in 1:count_nodes(graph)) {
graph <-
graph %>%
select_nodes_by_id(i) %>%
set_node_attrs(
node_attr = "type",
values = sample(
c("a", "b", "c"), count_nodes(graph), replace = TRUE))
}
#> `select_nodes_by_id()` INFO: created a new selection of 1 node
#> `select_nodes_by_id()` INFO: modified an existing selection of1 node:
#> * 2 nodesare now in the active selection
#> * used the `union` set operation
#> `select_nodes_by_id()` INFO: modified an existing selection of2 nodes:
#> * 3 nodesare now in the active selection
#> * used the `union` set operation
#> `select_nodes_by_id()` INFO: modified an existing selection of3 nodes:
#> * 4 nodesare now in the active selection
#> * used the `union` set operation
#> `select_nodes_by_id()` INFO: modified an existing selection of4 nodes:
#> * 5 nodesare now in the active selection
#> * used the `union` set operation
#> `select_nodes_by_id()` INFO: modified an existing selection of5 nodes:
#> * 6 nodesare now in the active selection
#> * used the `union` set operation
#> `select_nodes_by_id()` INFO: modified an existing selection of6 nodes:
#> * 7 nodesare now in the active selection
#> * used the `union` set operation
#> `select_nodes_by_id()` INFO: modified an existing selection of7 nodes:
#> * 8 nodesare now in the active selection
#> * used the `union` set operation
#> `select_nodes_by_id()` INFO: modified an existing selection of8 nodes:
#> * 9 nodesare now in the active selection
#> * used the `union` set operation
#> `select_nodes_by_id()` INFO: modified an existing selection of9 nodes:
#> * 10 nodesare now in the active selection
#> * used the `union` set operation
for(i in 1:count_edges(graph)) {
graph <-
graph %>%
set_edge_attrs(
from = get_edges(., return_type = "df")[i, 1],
to = get_edges(., return_type = "df")[i, 2],
edge_attr = "data_value",
values = sample(
seq(0, 8, 0.5), count_edges(graph), replace = TRUE))
}
# Look at the graph
graph %>% render_graph(output = "visNetwork")
set.seed(20)
# Create a graph with fruit,
# vegetables, nuts, and... people!
nodes <-
create_node_df(
n = 14,
type = c("person", "person",
"person", "person",
"person", "fruit",
"fruit", "fruit",
"veg", "veg", "veg",
"nut", "nut", "nut"),
label = c("Annie", "Donna",
"Justine", "Ed",
"Graham", "pineapple",
"apple", "apricot",
"cucumber", "celery",
"endive", "hazelnut",
"almond", "chestnut"))
edges <-
create_edge_df(
from = sort(
as.vector(replicate(5, 1:5))),
to = as.vector(
replicate(5, sample(6:14, 5))),
rel = as.vector(
replicate(
5, sample(
c("likes", "dislikes",
"allergic_to"), 5,
TRUE,
c(0.5, 0.25, 0.25)))))
graph <-
create_graph(
nodes_df = nodes,
edges_df = edges
)
# Have a look at the graph
graph %>% render_graph(output = "visNetwork")
graph_allergies <-
graph %>%
select_nodes(
conditions = type == "person") %>%
invert_selection() %>%
trav_in_edge(
conditions = rel == "allergic_to") %>%
trav_in_node() %>%
set_node_attrs_ws(node_attr = "color", value = "red") %>%
invert_selection() %>%
set_node_attrs_ws(node_attr = "color", value = "green") %>%
clear_selection() %>%
select_nodes(
conditions = type == "person") %>%
set_node_attrs_ws(node_attr = "color", value = "blue")
#> `select_nodes()` INFO: created a new selection of 5 nodes
#> `invert_selection()` INFO: inverted an existing selection of 5 nodes:
#> * 9 nodes are now in the active selection
#> `invert_selection()` INFO: inverted an existing selection of 5 nodes:
#> * 9 nodes are now in the active selection
#> `clear_selection()` INFO: cleared an existing selection of 9 nodes
#> `select_nodes()` INFO: created a new selection of 5 nodes
graph %>% get_edge_df
#> id from to rel
#> 1 1 1 13 likes
#> 2 2 1 12 dislikes
#> 3 3 1 7 dislikes
#> 4 4 1 9 likes
#> 5 5 1 10 allergic_to
#> 6 6 2 14 likes
#> 7 7 2 6 likes
#> 8 8 2 13 dislikes
#> 9 9 2 7 likes
#> 10 10 2 11 allergic_to
#> 11 11 3 12 likes
#> 12 12 3 14 likes
#> 13 13 3 6 dislikes
#> 14 14 3 10 allergic_to
#> 15 15 3 13 likes
#> 16 16 4 10 allergic_to
#> 17 17 4 8 likes
#> 18 18 4 6 likes
#> 19 19 4 7 likes
#> 20 20 4 14 dislikes
#> 21 21 5 10 likes
#> 22 22 5 6 allergic_to
#> 23 23 5 9 allergic_to
#> 24 24 5 13 likes
#> 25 25 5 7 allergic_to
# Display the modified graph, where green
# nodes represent safe foods for the
# group of people (blue nodes); red nodes
# are the danger foods
graph_allergies %>% render_graph(output = "visNetwork")
DiagrammeRに用意されているcsvファイルを使ってのグラフ生成contributors_csv <-
system.file("extdata", "contributors.csv",
package = "DiagrammeR")
colnames(read.csv(contributors_csv,
stringsAsFactors = FALSE))
#> [1] "name" "age" "join_date" "email"
#> [5] "follower_count" "following_count" "starred_count"
# Create a path to the CSV file containing
# information about the software projects
projects_csv <-
system.file("extdata/projects.csv",
package = "DiagrammeR")
colnames(read.csv(projects_csv,
stringsAsFactors = FALSE))
#> [1] "project" "start_date" "stars" "language"
# Create a path to the CSV file with information
# about the relationships between the projects
# and their contributors
projects_and_contributors_csv <-
system.file("extdata/projects_and_contributors.csv",
package = "DiagrammeR")
colnames(read.csv(projects_and_contributors_csv,
stringsAsFactors = FALSE))
#> [1] "project_name" "contributor_name" "contributor_role"
#> [4] "commits"
# Create the property graph by adding the CSV data to a
# new graph; the `add_nodes_from_csv()` and
# `add_edges_from_csv()` functions are used to create
# nodes and edges in the graph
graph <-
create_graph() %>%
set_graph_name("software_projects") %>%
add_nodes_from_table(
contributors_csv,
set_type = person,
label_col = name) %>%
add_nodes_from_table(
projects_csv,
set_type = project,
label_col = project) %>%
add_edges_from_table(
projects_and_contributors_csv,
from_col = contributor_name,
#from_mapping = "name",
to_col = project_name,
from_to_map = label,
rel_col = contributor_role)
get_node_df(graph)
#> id type label age join_date email
#> 1 1 person Dave 29 2012-03-23 dave_h@graphymail.com
#> 2 2 person Louisa 32 2010-02-15 lhe99@mailing-fun.com
#> 3 3 person Jack 35 2011-07-11 jack@ultramail.io
#> 4 4 person Josh 27 2014-10-28 josh_ch@megamail.kn
#> 5 5 person Sheryl 35 2009-06-20 sjo@examples-galore.fm
#> 6 6 person Roger 43 2012-01-03 roger_that@whalemail.net
#> 7 7 person Simone 25 2013-07-21 the_simone@a-q-w-o.net
#> 8 8 person Kim 37 2012-02-10 kim_3251323@ohhh.ai
#> 9 9 person Will 32 2015-07-15 the_will@graphymail.com
#> 10 10 person Jon 41 2009-10-06 j_2000@ultramail.io
#> 11 11 project stringbuildeR NA <NA> <NA>
#> 12 12 project supercalc NA <NA> <NA>
#> 13 13 project randomizer NA <NA> <NA>
#> follower_count following_count starred_count start_date stars language
#> 1 236 36 49 <NA> NA <NA>
#> 2 452 53 156 <NA> NA <NA>
#> 3 36 0 0 <NA> NA <NA>
#> 4 45 34 55 <NA> NA <NA>
#> 5 346 175 398 <NA> NA <NA>
#> 6 241 24 75 <NA> NA <NA>
#> 7 102 37 148 <NA> NA <NA>
#> 8 1563 485 237 <NA> NA <NA>
#> 9 23 76 16 <NA> NA <NA>
#> 10 87 24 0 <NA> NA <NA>
#> 11 NA NA NA 2013-05-28 154 R
#> 12 NA NA NA 2011-04-02 39 COBOL
#> 13 NA NA NA 2012-08-08 5328 Python
# View the graph
graph %>% render_graph(output = "visNetwork")
graph_scale_width_edges <-
graph %>%
select_edges() %>%
rescale_edge_attrs(
edge_attr_from = "commits", edge_attr_to = "width",
to_lower_bound = 0.5, to_upper_bound = 3.0)
#> `select_edges()` INFO: created a new selection of 13 edges
# Inspect the graph's internal EDF
get_edge_df(graph_scale_width_edges)
#> id from to rel commits width
#> 1 1 2 11 maintainer 236 0.750
#> 2 2 1 11 contributor 121 0.627
#> 3 3 3 11 contributor 32 0.532
#> 4 4 2 12 contributor 92 0.596
#> 5 5 4 12 contributor 124 0.630
#> 6 6 5 12 maintainer 1460 2.059
#> 7 7 4 13 maintainer 103 0.608
#> 8 8 6 13 contributor 236 0.750
#> 9 9 7 13 contributor 126 0.633
#> 10 10 8 13 contributor 2340 3.000
#> 11 11 9 13 contributor 2 0.500
#> 12 12 10 13 contributor 23 0.522
#> 13 13 2 13 contributor 287 0.805
# View the graph, larger edges and arrows
# indicate higher numbers of `commits`
graph_scale_width_edges %>% render_graph(output = "visNetwork")
graph_scale_color_edges <-
graph %>%
select_edges() %>%
rescale_edge_attrs(
edge_attr_from = "commits", edge_attr_to ="color",
to_lower_bound = "gray95", to_upper_bound = "gray5")
#> `select_edges()` INFO: created a new selection of 13 edges
# Render the graph, darker edges represent higher
# commits
graph_scale_color_edges %>% render_graph(output = "visNetwork")
graph <-
graph %>%
add_edge(
get_node_ids(.,
conditions = label == "Kim"),
get_node_ids(.,
conditions = label == "stringbuildeR"),
"contributor") %>%
select_last_edges_created() %>%
set_edge_attrs_ws("commits", 15) %>%
clear_selection()
#> `clear_selection()` INFO: cleared an existing selection of 1 edge
# View the graph's internal EDF, the newest
# edge is at the bottom
get_edge_df(graph)
#> id from to rel commits
#> 1 1 2 11 maintainer 236
#> 2 2 1 11 contributor 121
#> 3 3 3 11 contributor 32
#> 4 4 2 12 contributor 92
#> 5 5 4 12 contributor 124
#> 6 6 5 12 maintainer 1460
#> 7 7 4 13 maintainer 103
#> 8 8 6 13 contributor 236
#> 9 9 7 13 contributor 126
#> 10 10 8 13 contributor 2340
#> 11 11 9 13 contributor 2
#> 12 12 10 13 contributor 23
#> 13 13 2 13 contributor 287
#> 14 14 8 11 contributor 15
# View the graph to see the new edge
graph %>% render_graph(output = "visNetwork")
function(fun) fun()って感じのやつlambdaRパッケージもある。testa <- function() print("a")
testfun <- function(fun) {fun(); print(environment())}
replicate(3, testfun(testa))
#> [1] "a"
#> <environment: 0xf39def8>
#> [1] "a"
#> <environment: 0xf2b6b90>
#> [1] "a"
#> <environment: 0xedf2878>
#> [[1]]
#> <environment: 0xf39def8>
#>
#> [[2]]
#> <environment: 0xf2b6b90>
#>
#> [[3]]
#> <environment: 0xedf2878>
fun = function(){}とかのやつapplyファミリー, prrr::map*, stat_functionとかで使う()でくくると代入式でもリターンしてくれる(function(a, b) a + b)(a = 1, b = 2)
#> [1] 3
(test_unknown <- "Hello")
#> [1] "Hello"
(function(var, n) {
tmp <- var
for(i in 1:n) {
var <- (var + tmp/var) / 2
}
return(var)})(2, 10)
#> [1] 1.414214
do.call()は文字列を関数として扱うことができます。quoteとenvirは…評価タイミングがわかりにくいwhatは、関数のこと
args(引数)はlist型にするdo.call("rnorm", args = c(5))
#> Error in do.call("rnorm", args = c(5)): second argument must be a list
set.seed(20); do.call("rnorm", args = list(5))
#> [1] 1.1626853 -0.5859245 1.7854650 -1.3325937 -0.4465668
set.seed(20); do.call(rnorm, args = list(5))
#> [1] 1.1626853 -0.5859245 1.7854650 -1.3325937 -0.4465668
TRUEだとオブジェクトを評価しない
age <- 20
do.call(paste, list(age, "歳ですよ", sep = ""), quote = FALSE)
#> [1] "20歳ですよ"
do.call(paste, list(age, "歳ですよ", sep = ""), quote = TRUE)
#> [1] "20歳ですよ"
do.call(paste, list(as.name(age), "歳ですよ", sep = ""), quote = FALSE)
#> Error in (function (..., sep = " ", collapse = NULL) : object '20' not found
do.call(paste, list(as.name("age"), "歳ですよ", sep = ""), quote = FALSE)
#> [1] "20歳ですよ"
do.call(paste, list(as.name(age), "歳ですよ", sep = ""), quote = TRUE)
#> [1] "20歳ですよ"
name型は、symbol型のエイリアス(別名てきなやつ)
:symbol, "character"as.name(age) ; as.name("age")
#> `20`
#> age
as.symbol(age); as.symbol("age")
#> `20`
#> age
envirについては、レキシカルスコープが絡むので、今回は省くenvはlist型をうけとるset.seed(20)
(hoge <- rnorm(5))
#> [1] 1.1626853 -0.5859245 1.7854650 -1.3325937 -0.4465668
(names(hoge) <- c("test1", "test2", "test3", "test4", "test5"))
#> [1] "test1" "test2" "test3" "test4" "test5"
substitute(max(hoge))
#> max(hoge)
substitute(max(test1))
#> max(test1)
substitute(max("test1"))
#> max("test1")
substitute(max("test1"), env = hoge)
#> Error in substitute(max("test1"), env = hoge): invalid environment specified
.GlobalEnvにオブジェクトがあっても勝手に置換されないhoge <- as.list(hoge)
substitute(max(test1))
#> max(test1)
substitute(max("test1"))
#> max("test1")
substitute(max("test1"), env = hoge)
#> max("test1")
substitute(max(test1), env = hoge)
#> max(1.1626852897838)
hoge$test12 <- {set.seed(20); rnorm(5)}
hoge$test12
#> [1] 1.1626853 -0.5859245 1.7854650 -1.3325937 -0.4465668
substitute(max(test12), env = hoge)
#> max(c(1.1626852897838, -0.585924465893051, 1.78546500331661,
#> -1.33259371048501, -0.446566766553219))
substitute()の第一引数exprfuga <- substitute(max(test1), env = hoge)
fuga
#> max(1.1626852897838)
class(fuga)
#> [1] "call"
mode(fuga)
#> [1] "call"
typeof(fuga)
#> [1] "language"
class(fuga) <- "character"
fuga
#> [1] "max" "1.1626852897838"
| class | mode | typeof |
|---|---|---|
call |
call |
language |
つまり、文字列ではない
ベクトルになっている
evalは、表現式を実行します。set.seed(20)
eval("rnorm(5)")
#> [1] "rnorm(5)"
eval(rnorm("5"))
#> [1] 1.1626853 -0.5859245 1.7854650 -1.3325937 -0.4465668
eval(rnorm(a), envir = list(a = 5))
#> Warning in rnorm(a): NAs introduced by coercion
#> Error in rnorm(a): invalid arguments
evalq(rnorm(a), envir = list(a = 5))
#> [1] 0.5696061 -2.8897176 -0.8690183 -0.4617027 -0.5555409
evalの方は、aを展開しようとするevalとsubstituteとdo.callを使うのが主流らしいevalとparseでは遅いらしいstr(hoge)
#> List of 6
#> $ test1 : num 1.16
#> $ test2 : num -0.586
#> $ test3 : num 1.79
#> $ test4 : num -1.33
#> $ test5 : num -0.447
#> $ test12: num [1:5] 1.163 -0.586 1.785 -1.333 -0.447
substitute(max(test12), env = hoge)
#> max(c(1.1626852897838, -0.585924465893051, 1.78546500331661,
#> -1.33259371048501, -0.446566766553219))
eval(
substitute(
max(test12),
env = hoge
)
)
#> [1] 1.785465
microbenchmark::microbenchmark(
esd = function() eval(substitute(do.call(func, args = list(n = 30)), env = list(func = "rnorm"))),
ep = function() eval(parse(text = paste0("rnorm", "(", "n" ,")")), envir = list(n = 30)),
times = 20
)
#> Unit: nanoseconds
#> expr min lq mean median uq max neval
#> esd 369 387.0 398.45 394.5 405.5 491 20
#> ep 372 378.5 791.85 398.0 414.0 5611 20
Rだとポインタはないことになってる
ここからはC言語をベースにしていきたいと思います
ポインタというのは、値が入っているメモリのアドレスを参照すること
足し算をしてみると
void plusfunc(double *x, double *y, double *res) {
*res = *x + *y;
}
#> gcc -m64 -std=gnu99 -I/usr/include/R -DNDEBUG -I/usr/local/include -fpic -O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector-strong --param=ssp-buffer-size=4 -grecord-gcc-switches -m64 -mtune=generic -c ce3f7afd07e4.c -o ce3f7afd07e4.o
#> gcc -m64 -std=gnu99 -shared -L/usr/lib64/R/lib -Wl,-z,relro -o ce3f7afd07e4.so ce3f7afd07e4.o -L/usr/lib64/R/lib -lR
a <- 5; b <- 6; res <- 0;
.C('plusfunc',as.numeric(a), as.numeric(b), res = as.numeric(res) )
#> [[1]]
#> [1] 5
#>
#> [[2]]
#> [1] 6
#>
#> $res
#> [1] 11
grViz("
digraph graph_pointer_c {
graph [ rankdir = RL,
newrank = true ] // --------------------
node [ shape = box ] // ------------------------
subgraph cluster_a {
label = 'aのアドレスと値'
a_address [ label = 'aのアドレス\n120' ]
a [label = 'a\n6']
}
subgraph cluster_x {
label = 'xのアドレスと値'
x_address [ label = 'xのアドレス\n200' ]
x [ label = 'x\n120' ]
x_pointer [ label = '*x\n6' ]
}
edge [] // ------------------------
a_address -> x [ color = '#ff0000' ]
x_pointer -> a [ color = '#660000' ]
{rank = max; x_address; x; x_pointer}
{rank = min; a_address; a;}
}")
a <- 2
a
#> [1] 2
a <- "char"
a
#> [1] "char"
a <- TRUE
a
#> [1] TRUE
# r4dsだとdiamondsを使っている
mtcars2 <- mtcars
pryr::object_size(mtcars)
#> 6.74 kB
pryr::object_size(mtcars2)
#> 6.74 kB
pryr::object_size(mtcars, mtcars2)
#> 6.74 kB
mtcars3 <- mtcars %>%
mutate(tpg = mpg / ( 4 * qsec ))
pryr::object_size(mtcars)
#> 6.74 kB
pryr::object_size(mtcars3)
#> 4.95 kB
pryr::object_size(mtcars, mtcars3)
#> 7.68 kB
as_tibble(mtcars) %>% head() %>%
knitr::kable()
| mpg | cyl | disp | hp | drat | wt | qsec | vs | am | gear | carb |
|---|---|---|---|---|---|---|---|---|---|---|
| 21.0 | 6 | 160 | 110 | 3.90 | 2.620 | 16.46 | 0 | 1 | 4 | 4 |
| 21.0 | 6 | 160 | 110 | 3.90 | 2.875 | 17.02 | 0 | 1 | 4 | 4 |
| 22.8 | 4 | 108 | 93 | 3.85 | 2.320 | 18.61 | 1 | 1 | 4 | 1 |
| 21.4 | 6 | 258 | 110 | 3.08 | 3.215 | 19.44 | 1 | 0 | 3 | 1 |
| 18.7 | 8 | 360 | 175 | 3.15 | 3.440 | 17.02 | 0 | 0 | 3 | 2 |
| 18.1 | 6 | 225 | 105 | 2.76 | 3.460 | 20.22 | 1 | 0 | 3 | 1 |
as_tibble(mtcars3) %>% head() %>%
knitr::kable()
| mpg | cyl | disp | hp | drat | wt | qsec | vs | am | gear | carb | tpg |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 21.0 | 6 | 160 | 110 | 3.90 | 2.620 | 16.46 | 0 | 1 | 4 | 4 | 0.3189550 |
| 21.0 | 6 | 160 | 110 | 3.90 | 2.875 | 17.02 | 0 | 1 | 4 | 4 | 0.3084606 |
| 22.8 | 4 | 108 | 93 | 3.85 | 2.320 | 18.61 | 1 | 1 | 4 | 1 | 0.3062869 |
| 21.4 | 6 | 258 | 110 | 3.08 | 3.215 | 19.44 | 1 | 0 | 3 | 1 | 0.2752058 |
| 18.7 | 8 | 360 | 175 | 3.15 | 3.440 | 17.02 | 0 | 0 | 3 | 2 | 0.2746769 |
| 18.1 | 6 | 225 | 105 | 2.76 | 3.460 | 20.22 | 1 | 0 | 3 | 1 | 0.2237883 |
grViz("
digraph memory_image {
graph [ charset = 'UTF-8',
rankdir = BT,
compound = true
]
node [ shape = egg ]
subgraph cluster_value {
mpg; cyl; disp;
hp; drat; wt;
qsec; vs; am;
gear; carb;
}
tpg;
mtcars;
mtcars3;
edge[]
mtcars -> wt [ lhead = cluster_value, headport = s ]
mtcars3 -> disp [ lhead = cluster_value, headport = s ]
mtcars3 -> tpg
}")
今回は、ShinyやDiagrammeR, C言語をメインに紹介しました。
まだまだ、紹介しきれていないことも多いので、
ぜひ、次回の開催ができるようにしていきたいと思います。
Enjoy!
$ sudo apt-get install virtualbox
sudo vim /etc/apt/sources.list
ここに、
deb https://download.virtualbox.org/virtualbox/debian xenial contrib
これを追加する。
wget -q https://www.virtualbox.org/download/oracle_vbox_2016.asc -O- | sudo apt-key add -
wget -q https://www.virtualbox.org/download/oracle_vbox.asc -O- | sudo apt-key add -
sudo apt-get update
sudo apt-get install virtualbox-5.2
vboxmanage -v
wget https://releases.hashicorp.com/vagrant/2.1.2/vagrant_2.1.2_x86_64.deb
sudo dpkg -i vagrant_2.1.2_x86_64.deb
vagrant -v
centos/7を使うvagrant box add centos/7
このとき、
3) virtualbox
と選択を迫られたら、
3を入力して、Enter
vagrant box list
mkdir -p ~/vagrant/centos7
cd ~/vagrant/centos7
vagrant init
# もしエラーが出たら
vagrant init centos7
vagrant ssh
これでcentosにログインできたと思います
これからRとrstudio-serverをインストールします
sudo yum install epel-release
sudo yum --enablerepo=epel install R
sudo yum install wget
wget https://download2.rstudio.org/rstudio-server-rhel-1.1.442-x86_64.rpm
ls
sudo yum install rstudio-server-rhel-1.1.442-x86_64.rpm
というわけで、割愛!
調整できたら、載せます
sudo vim /etc/yum.repos.d/nginx.repo
[nginx] name=nginx repo baseurl=http://nginx.org/packages/centos/7/$basearch/ gpgcheck=0 enabled=1
sudo yum -y --enablerepo=nginx install nginx
nginx -v
sudo yum -y install net-tools
sudo systemctl enable nginx
sudo systemctl start nginx
sudo su - \
-c "R -e \"install.packages('shiny', repos='https://cran.rstudio.com/')\""
repos は、お近くのサーバーで良いかと
あとは、インストール
wget https://download3.rstudio.org/centos6.3/x86_64/shiny-server-1.5.7.907-rh6-x86_64.rpm
sudo yum install --nogpgcheck shiny-server-1.5.7.907-rh6-x86_64.rpm
sudo systemctl enable shiny-server
sudo systemctl start shiny-server
rmarkdownの部分は適宜、パッケージ名で置き換えてくださいsudo su - -c "R -e \"install.packages('rmarkdown', repos='https://cran.rstudio.com/')\""
もし、わかりにくかったら連絡ください。 修正します。
通常の正規表現で使えるのは、以下のメタキャラクタ
| メタキャラクタ | 効果 |
|---|---|
| . | 任意の一文字 |
| * | 0回以上の繰り返し |
| [文字] | どれか文字にマッチする |
| ^ | アンカー、先頭のこと |
| $ | アンカー、末尾のこと |
| {n,m} | n回以上、m回以下の繰り返し |
| \(…\) | \(と\)で囲まれた文字列を保存する |
| \ | エスケープ |
拡張正規表現に対応しているもので使用可能。
| 拡張メタキャラクタ | 効果 | 通常のメタキャラクタでの表現 |
|---|---|---|
| + | 1回以上の繰り返し | \{1,\} または ..* |
| ? | 0回か1回の連続 | \{0,1\} |
| またはの意味(優先度高い) |
ただし、使用する言語、ソフトによっては別の拡張メタキャラクタセットを使用可能。
#vimを探してみる
dpkg -l | grep 'vim'
#前後に任意の文字が0個以上あるもの
dpkg -l | grep '.*vim.*'
#vimのみを探してみる
#前後のスペースを一回以上にしてみる
dpkg -l | grep ' \{1,\}vim \{1,\}'
#こんな感じにも書ける
dpkg -l | grep ' *vim *'
\を使いたい場合は、\\と\を重ねる必要があるescape <- "this is tasty."
writeLines(escape)
#> this is tasty.
#str_extract(escape, "\.")
#> Error: '\.' is an unrecognized escape in character string starting ""\."
str_extract(escape, "\\.")
#> [1] "."
str_extract(escape, "..*\\.")
#> [1] "this is tasty."
mermaid("
graph LR
str[文字列]
reg[正規表現]
pat[パターン]
str-->|\\|reg
reg-->|\\|pat
")
文字列の置換に便利な言語
| コマンド | 効果 | 表現 |
|---|---|---|
| s | 置換する | /アドレス/s/パターン/置換後のパターン/ |
| y | パターンで指定したものを入れ替える | y/パターン/パターン/ |
| p | 表示する | アドレス/p |
| d | 削除して一行目に戻る | アドレス/d |
他にも大文字コマンドがあるが、使用方法が難しいので今回は割愛します。
#vimをemacsにしてみる
dpkg -l | grep 'vim' | sed -e 's/vim/emacs/'
#Vim vim Vi vi などのすべてをemacsにしてみる
#最後のgrepはemacsをハイライトさせるため
dpkg -l | grep '[Vv][Ii][Mm]*' | sed -e 's/[Vv][Ii][Mm]*/emacs/' | grep 'emacs'
#Vim vim Vi vi だけをemacsにしてみる
dpkg -l | grep '[Vv]im*' | sed -e 's/[Vv]im*/emacs/' | grep 'emacs'
#このやり方だとvideoなども含まれる
#もう一度やりなおす
dpkg -l | grep '[^a-z][Vv]im*[^a-z]' | sed -e 's/[^a-z][Vv]im*[^a-z]/emacs/' | grep 'emacs'
#だいぶ直ったけど、Vi IMprovedはのこったまま
#Vi IMprovedもemacsに変えてみる
dpkg -l | grep '[^a-z][Vv]im*[^a-z]' | sed -e 's/[^a-z][Vv]im*[^a-z]/emacs/' | sed -e 's/Vi IMproved/emacs/' | grep 'emacs'
grepの抽出とsedのパターン指定が重複してるけど、あんまり意味はない
強いて言うなら、sedのアドレス指定を明示的にするため
grep '[^a-z][Vv]im*[^a-z]' | sed -e 's/[^a-z][Vv]im*[^a-z]/emacs/'
sed -e '/[^a-z][Vv]im*[^a-z]/s/[^a-z][Vv]im*[^a-z]/emacs/'
sed -e '/[^a-z][Vv]im*[^a-z]/s//emacs/'
すべて等価な表現
#viなどをemacs単体に変えて表示
dpkg -l | sed -n -e '/..*[^a-z]\([Vv]im*\)[^a-z]..*/s//\1toemacs/p'
sedのオプション -n は自動出力をやめるオプション
pコマンドは表示させるオプション
pの後ろにスラッシュはいらない
\(文字列\)で保存できる\1,\2のように\の後に数字をつける
\(a\)``\(b\)のように複数保存した場合、参照は手前から順に1,2,となる\([Vv]im*\)を保存して参照すると、viとなっている。